{-# LANGUAGE RecordWildCards #-}

module App.Fossa.Config.Report (
  ReportConfig (..),
  ReportCliOptions,
  ReportOutputFormat (..),
  ReportType (..),
  ReportBase (..),
  mkSubCommand,
  -- Exported for testing
  parseReportOutputFormat,
) where

import App.Fossa.Config.Common (
  CacheAction (ReadOnly),
  CommonOpts (..),
  baseDirArg,
  collectApiOpts,
  collectBaseDir,
  collectBaseFile,
  collectRevisionData',
  commonOpts,
  defaultTimeoutDuration,
 )
import App.Fossa.Config.ConfigFile (ConfigFile, resolveLocalConfigFile)
import App.Fossa.Config.EnvironmentVars (EnvVars)
import App.Fossa.Config.SBOM.Common qualified as SBOMCfg
import App.Fossa.Subcommand (EffStack, GetCommonOpts (getCommonOpts), GetSeverity (getSeverity), SubCommand (SubCommand))
import App.Types (BaseDir (..), OverrideProject (OverrideProject), ProjectRevision)
import Control.Applicative ((<|>))
import Control.Effect.Diagnostics (Diagnostics, ToDiagnostic (renderDiagnostic), errHelp, fatal, fromMaybe)
import Control.Effect.Diagnostics qualified as Diag
import Control.Effect.Lift (Has, Lift)
import Control.Timeout (Duration (Seconds))
import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding)
import Data.Error (SourceLocation, createEmptyBlock, getSourceLocation)
import Data.List (intercalate)
import Data.String.Conversion (ToText, toText)
import Data.String.Conversion qualified as Conv
import Data.Text (Text)
import Effect.Exec (Exec)
import Effect.Logger (Logger, Severity (..), vsep)
import Effect.ReadFS (ReadFS)
import Errata (Errata (..), errataSimple)
import Fossa.API.Types (ApiOpts)
import GHC.Generics (Generic)
import Options.Applicative (
  InfoMod,
  Parser,
  argument,
  auto,
  long,
  maybeReader,
  metavar,
  option,
  optional,
  progDescDoc,
  strOption,
  switch,
 )
import Options.Applicative.Builder (helpDoc)
import Path
import Prettyprinter (Doc, comma, hardline, punctuate, viaShow)
import Prettyprinter.Render.Terminal (AnsiStyle, Color (Green, Red))
import Style (applyFossaStyle, boldItalicized, coloredBoldItalicized, formatDoc, stringToHelpDoc, styledDivider)

data ReportType = Attribution deriving (Eq, Ord, Enum, Bounded, Generic)

instance ToJSON ReportType where
  toEncoding = genericToEncoding defaultOptions

instance Show ReportType where
  show Attribution = "attribution"

data ReportOutputFormat
  = ReportCSV
  | -- Core will return the cyclonedx report with license data encoded in base64.
    -- This is specified in the bom schema: https://github.com/CycloneDX/specification/blob/1.4/schema/bom-1.4.schema.json#L529
    ReportCycloneDXJSON
  | ReportCycloneDXXML
  | ReportHTML
  | ReportJson
  | ReportMarkdown
  | ReportPlainText
  | ReportSpdx
  | ReportSpdxJSON
  deriving (Eq, Ord, Enum, Bounded, Generic)

parseReportOutputFormat :: String -> Maybe ReportOutputFormat
parseReportOutputFormat s | s == show ReportJson = Just ReportJson
parseReportOutputFormat s | s == show ReportSpdx = Just ReportSpdx
parseReportOutputFormat s | s == show ReportMarkdown = Just ReportMarkdown
parseReportOutputFormat s | s == show ReportPlainText = Just ReportPlainText
parseReportOutputFormat s | s == show ReportSpdxJSON = Just ReportSpdxJSON
parseReportOutputFormat s | s == show ReportCycloneDXJSON = Just ReportCycloneDXJSON
parseReportOutputFormat s | s == show ReportCycloneDXXML = Just ReportCycloneDXXML
parseReportOutputFormat s | s == show ReportHTML = Just ReportHTML
parseReportOutputFormat s | s == show ReportCSV = Just ReportCSV
parseReportOutputFormat _ = Nothing

instance ToText ReportOutputFormat where
  toText = toText . show

instance Show ReportOutputFormat where
  show ReportJson = "json"
  show ReportMarkdown = "markdown"
  show ReportSpdx = "spdx"
  show ReportPlainText = "text"
  show ReportSpdxJSON = "spdx-json"
  show ReportCycloneDXJSON = "cyclonedx-json"
  show ReportCycloneDXXML = "cyclonedx-xml"
  show ReportHTML = "html"
  show ReportCSV = "csv"

allFormats :: [ReportOutputFormat]
allFormats = enumFromTo minBound maxBound

reportOutputFormatList :: String
reportOutputFormatList = intercalate ", " $ map show allFormats

styledReportOutputFormats :: Doc AnsiStyle
styledReportOutputFormats = mconcat $ punctuate styledDivider coloredAllFormats
  where
    coloredAllFormats :: [Doc AnsiStyle]
    coloredAllFormats = map (coloredBoldItalicized Green . viaShow) allFormats

instance ToJSON ReportOutputFormat where
  toEncoding = genericToEncoding defaultOptions

allReports :: [ReportType]
allReports = enumFromTo minBound maxBound

reportInfo :: InfoMod a
reportInfo = progDescDoc (Just $ formatDoc desc)
  where
    desc :: Doc AnsiStyle
    desc =
      "Access various reports from FOSSA and print to stdout"
        <> hardline
        <> "Currently available reports: "
        <> mconcat (punctuate comma (map viaShow allReports))
        <> hardline
        <> "Example: "
        <> "fossa report --format html attribution"

mkSubCommand :: (ReportConfig -> EffStack ()) -> SubCommand ReportCliOptions ReportConfig
mkSubCommand = SubCommand "report" reportInfo parser loadConfig mergeOpts

parser :: Parser ReportCliOptions
parser =
  ReportCliOptions
    <$> commonOpts
    <*> switch (applyFossaStyle <> long "json" <> helpDoc jsonHelp)
    <*> optional (strOption (applyFossaStyle <> long "format" <> helpDoc formatHelp))
    <*> optional (option auto (applyFossaStyle <> long "timeout" <> stringToHelpDoc "Duration to wait for build completion (in seconds)"))
    <*> reportTypeArg
    <*> basePath
  where
    basePath :: Parser Text
    basePath = (Conv.toText <$> baseDirArg) <|> (SBOMCfg.unSBOMFile <$> SBOMCfg.sbomFileArg)

    jsonHelp :: Maybe (Doc AnsiStyle)
    jsonHelp =
      Just . formatDoc $
        vsep
          [ "Output the report in JSON format. Equivalent to " <> coloredBoldItalicized Green "--format json" <> " and overrides " <> coloredBoldItalicized Green "--format"
          , coloredBoldItalicized Red "Deprecated: " <> "prefer " <> coloredBoldItalicized Green "--format"
          ]

    formatHelp :: Maybe (Doc AnsiStyle)
    formatHelp =
      Just . formatDoc $
        vsep
          [ "Output the report in the specified format"
          , boldItalicized "Formats: " <> styledReportOutputFormats
          ]

reportTypeArg :: Parser ReportType
reportTypeArg = argument (maybeReader parseType) (applyFossaStyle <> metavar "REPORT" <> stringToHelpDoc "The report type to fetch from the server")
  where
    parseType :: String -> Maybe ReportType
    parseType = \case
      "attribution" -> Just Attribution
      _ -> Nothing

data ReportCliOptions = ReportCliOptions
  { commons :: CommonOpts
  , cliReportJsonOutput :: Bool
  , cliReportOutputFormat :: Maybe String
  , cliReportTimeout :: Maybe Int
  , cliReportType :: ReportType
  , cliReportBase :: Text
  }
  deriving (Eq, Ord, Show)

instance GetSeverity ReportCliOptions where
  getSeverity ReportCliOptions{..} = if (optDebug commons) then SevDebug else SevInfo

instance GetCommonOpts ReportCliOptions where
  getCommonOpts ReportCliOptions{..} = Just commons

loadConfig ::
  ( Has (Lift IO) sig m
  , Has ReadFS sig m
  , Has Diagnostics sig m
  , Has Logger sig m
  ) =>
  ReportCliOptions ->
  m (Maybe ConfigFile)
loadConfig = resolveLocalConfigFile . optConfig . commons

mergeOpts ::
  ( Has (Lift IO) sig m
  , Has ReadFS sig m
  , Has Logger sig m
  , Has Diagnostics sig m
  , Has Exec sig m
  ) =>
  Maybe FilePath ->
  Maybe ConfigFile ->
  EnvVars ->
  ReportCliOptions ->
  m ReportConfig
mergeOpts _ cfgfile envvars ReportCliOptions{..} = do
  let apiOpts = collectApiOpts cfgfile envvars commons
      outputformat = validateOutputFormat cliReportJsonOutput cliReportOutputFormat
      timeoutduration = maybe defaultTimeoutDuration Seconds cliReportTimeout
      projectOverride = OverrideProject (optProjectName commons) (optProjectRevision commons) Nothing

  (revision, reportBase) <- generateDirOrSBOMBase cliReportBase projectOverride

  ReportConfig
    <$> apiOpts
    <*> pure reportBase
    <*> outputformat
    <*> pure timeoutduration
    <*> pure cliReportType
    <*> pure revision
  where
    generateDirOrSBOMBase ::
      ( Has Exec sig m
      , Has Logger sig m
      , Has (Lift IO) sig m
      , Has ReadFS sig m
      , Has Diagnostics sig m
      ) =>
      Text ->
      OverrideProject ->
      m (ProjectRevision, ReportBase)
    generateDirOrSBOMBase path projectOverride = do
      basedir <- Diag.recover $ collectBaseDir (Conv.toString path)
      case basedir of
        Just dir ->
          (,)
            <$> collectRevisionData' (pure dir) cfgfile ReadOnly projectOverride
            <*> pure (DirectoryBase . unBaseDir $ dir)
        Nothing -> do
          baseFile <- Diag.recover $ collectBaseFile (Conv.toString path)
          case baseFile of
            Just file ->
              (,)
                <$> SBOMCfg.getProjectRevision (SBOMCfg.SBOMFile (toText file)) projectOverride ReadOnly
                <*> pure (SBOMBase file)
            Nothing -> Diag.fatalText $ "No such file or directory " <> path

newtype NoFormatProvided = NoFormatProvided SourceLocation
instance ToDiagnostic NoFormatProvided where
  renderDiagnostic :: NoFormatProvided -> Errata
  renderDiagnostic (NoFormatProvided srcLoc) =
    errataSimple (Just "No format provided") (createEmptyBlock srcLoc) Nothing

data InvalidReportFormat = InvalidReportFormat SourceLocation String
instance ToDiagnostic InvalidReportFormat where
  renderDiagnostic :: InvalidReportFormat -> Errata
  renderDiagnostic (InvalidReportFormat srcLoc fmt) = do
    let header = "Report format: " <> toText fmt <> " is not supported"
    errataSimple (Just header) (createEmptyBlock srcLoc) Nothing

data ReportErrorHelp = ReportErrorHelp
instance ToDiagnostic ReportErrorHelp where
  renderDiagnostic :: ReportErrorHelp -> Errata
  renderDiagnostic ReportErrorHelp = do
    let header = "Provide a supported format via '--format'. Supported formats: " <> (toText reportOutputFormatList)
    Errata (Just header) [] Nothing

validateOutputFormat :: Has Diagnostics sig m => Bool -> Maybe String -> m ReportOutputFormat
validateOutputFormat True _ = pure ReportJson
validateOutputFormat False Nothing = errHelp ReportErrorHelp $ fatal $ NoFormatProvided getSourceLocation
validateOutputFormat False (Just format) = errHelp ReportErrorHelp $ fromMaybe (InvalidReportFormat getSourceLocation format) $ parseReportOutputFormat format

data ReportConfig = ReportConfig
  { apiOpts :: ApiOpts
  , reportBase :: ReportBase
  , outputFormat :: ReportOutputFormat
  , timeoutDuration :: Duration
  , reportType :: ReportType
  , revision :: ProjectRevision
  }
  deriving (Eq, Ord, Show, Generic)

data ReportBase
  = SBOMBase (Path Abs File)
  | DirectoryBase (Path Abs Dir)
  deriving (Eq, Ord, Show, Generic)

instance ToJSON ReportBase where
  toEncoding = genericToEncoding defaultOptions

instance ToJSON ReportConfig where
  toEncoding = genericToEncoding defaultOptions
